home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
DP Tool Club 19
/
CD_ASCQ_19_010295.iso
/
dos
/
prg
/
pas
/
swag
/
mouse.swg
/
0025_Gfx mouse in textmode?.pas
< prev
Wrap
Pascal/Delphi Source File
|
1994-11-30
|
5KB
|
179 lines
{
JK> Could anybody send me a routine that uses graphical mouse pointer
JK> in 80x25 textmode? I don't want a block cursor which moves from
JK> character to another (it's not very accurate). I would need a
JK> arrow pointer which can be moved softly around the screen.
It aint perfect - it's a little shocky - but it works, and might give you a
clue on how to operate. A credit would be in place. ;-)
Check this:
>--- cut here
}
program txtmouse;
{ Graphics mouse cursor in textmode, by Bas van Gaalen,
fido 2:285/213.8, internet bas.van.gaalen@schotman.nl, Holland, PD }
uses
crt;
const
setimg=0; getimg=1;
vidseg:word=$b800;
mscursor:array[0..7] of byte=(252,248,248,248,252,142,7,3);
type
worktype=array[0..3,0..7] of byte;
var
pdata:array[0..3] of byte;
px,py:byte;
{ mouse routines ----------------------------------------------------------- }
function mouseinstalled:boolean; assembler; asm
xor ax,ax; int 33h; cmp ax,-1; je @skip; xor al,al; @skip: end;
function getmousex:word; assembler; asm
mov ax,3; int 33h; mov ax,cx end;
function getmousey:word; assembler; asm
mov ax,3; int 33h; mov ax,dx end;
function leftpressed:boolean; assembler; asm
mov ax,3; int 33h; and bx,1; mov ax,bx end;
function rightpressed:boolean; assembler; asm
mov ax,3; int 33h; and bx,2; mov ax,bx end;
procedure mousesensetivity(x,y:word); assembler; asm
mov ax,1ah; mov bx,x; mov cx,y; xor dx,dx; int 33h end;
procedure mousewindow(l,t,r,b:word); assembler; asm
mov ax,7; mov cx,l; mov dx,r; int 33h; mov ax,8
mov cx,t; mov dx,b; int 33h end;
function hardx:byte; begin hardx:=getmousex div 8; end;
function hardy:byte; begin hardy:=getmousey div 8; end;
function smoothx:word; begin smoothx:=getmousex mod 8; end;
function smoothy:word; begin smoothy:=getmousey mod 8; end;
{ -------------------------------------------------------------------------- }
procedure getsetimage(chr:byte; var data; getset:byte); assembler;
asm
push ds
mov al,32
mul [chr]
cmp getset,getimg
je @goget
mov di,ax
mov ax,0a000h
mov es,ax
mov cx,8/2
lds si,data
jmp @start
@goget:
mov si,ax
mov ax,0a000h
mov ds,ax
mov cx,8/2
les di,data
@start:
cli
mov dx,03c4h; mov ax,0402h; out dx,ax; mov ax,0704h; out dx,ax
mov dx,03ceh; mov ax,0204h; out dx,ax; mov ax,0005h; out dx,ax;
mov ax,0006h; out dx,ax
rep movsw
mov dx,03c4h; mov ax,0302h; out dx,ax; mov ax,0304h; out dx,ax
mov dx,03ceh; mov ax,0004h; out dx,ax; mov ax,1005h; out dx,ax;
mov ax,0e06h; out dx,ax
sti
pop ds
end;
{ -------------------------------------------------------------------------- }
procedure retrace; assembler; asm
mov dx,03dah
@vert1: in al,dx; test al,8; jnz @vert1
@vert2: in al,dx; test al,8; jz @vert2
end;
{ save old characters to screen }
procedure saveold;
begin
pdata[0]:=mem[vidseg:py*160+px*2];
pdata[1]:=mem[vidseg:py*160+(px+1)*2];
pdata[2]:=mem[vidseg:(py+1)*160+px*2];
pdata[3]:=mem[vidseg:(py+1)*160+(px+1)*2];
end;
{ restore old characters to screen }
procedure restoreold;
begin
mem[vidseg:py*160+px*2]:=pdata[0];
mem[vidseg:py*160+(px+1)*2]:=pdata[1];
mem[vidseg:(py+1)*160+px*2]:=pdata[2];
mem[vidseg:(py+1)*160+(px+1)*2]:=pdata[3];
end;
{ clear 'data' }
procedure cleardata(var data:worktype); begin
fillchar(data,sizeof(data),0); end;
{ get chars from screen and put font-data in 'data' }
procedure getscrdata(var data:worktype);
var ch,i,j,x,y:byte;
begin
x:=hardx; y:=hardy;
getsetimage(mem[vidseg:y*160+x*2],data[0],getimg);
getsetimage(mem[vidseg:y*160+(x+1)*2],data[1],getimg);
getsetimage(mem[vidseg:(y+1)*160+x*2],data[2],getimg);
getsetimage(mem[vidseg:(y+1)*160+(x+1)*2],data[3],getimg);
end;
{ add info-font-data and mouse-arrow together }
procedure addata(var data:worktype);
var i:byte;
begin
for i:=0 to 7-smoothy do data[0,i+smoothy]:=data[0,i+smoothy] or (mscursor[i]
shr smoothx); for i:=0 to 7-smoothy do data[1,i+smoothy]:=data[1,i+smoothy] or
(mscursor[i] shl (8-smoothx)); for i:=0 to smoothy do data[2,i]:=data[2,i] or
(mscursor[8-smoothy+i] shr smoothx); for i:=0 to smoothy do
data[3,i]:=data[3,i] or (mscursor[8-smoothy+i] shl (8-smoothx));end;
{ place graphicsmouse on textscreen }
procedure placemouse(data:worktype);
var i,x,y:byte;
begin
for i:=0 to 3 do getsetimage(219+i,data[i],setimg);
x:=hardx; y:=hardy; px:=x; py:=y; saveold;
mem[vidseg:py*160+px*2]:=219;
mem[vidseg:py*160+(px+1)*2]:=220;
mem[vidseg:(py+1)*160+px*2]:=221;
mem[vidseg:(py+1)*160+(px+1)*2]:=222;
end;
{ -------------------------------------------------------------------------- }
var
ms:worktype;
i,j,x,y:byte;
begin
textmode(co80+font8x8);
mem[$40:$49]:=6; { fool mouse to be in graphics-mode (needed for smooth) }
if not mouseinstalled then begin writeln('need mouse.'); halt; end;
mousesensetivity(20,20);
mousewindow(0,0,639-8,399-8);
for i:=10 to 69 do for j:=0 to 35 do memw[vidseg:4*160+j*160+i+i]:=((j*20+i)
mod 255)+7*256; px:=hardx; py:=hardy; saveold;
while not leftpressed do begin
write(#13,hardx:2,',',hardy:2);
retrace;
restoreold;
cleardata(ms);
getscrdata(ms);
addata(ms);
placemouse(ms);
end;
textmode(lastmode);
end.